home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PAS_0793 / INPLINE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-01  |  4KB  |  119 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 272 of 278
  3. From : BRIAN PAPE                          1:2250/26.0          24 Jul 93  17:42
  4. To   : ALL
  5. Subj : Input Line Source Code
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Code by Brian Pape. As of today (7-24-93), it is in the public domain; for
  8. personal use you may do whatever you like.  However, if is to be included
  9. in a library or collection of code, mention my name as being the code's
  10. source, and DO NOT (a la Ecolib) distribute it with commercial software
  11. illegally!}
  12.  
  13. { Written by Brian Pape, (c) Copyright 1992.
  14.   Note: This code is an attempt at an input line.  It probably still needs
  15.   modifications.
  16.  
  17.   This procedure will get input from the user.
  18.   s- the string returned from the procedure
  19.   hidden- this is if you want the input shown as a different character
  20.           than what is typed (for instance, for a password)
  21.   hc- the character you want displayed if HIDDEN is true
  22.   x1,y1- the x,y coordinates to display the input line at (1 based)
  23.   len- the max length of the input line
  24.   strlen- the max length of the input string
  25.   txt_at- the color attribute (same format as TEXTATTR built into the CRT
  26.           unit (high 4 bits, bckgnd, low 4 bits, foreground))
  27.   scrl_at- the attribute used for the scroller characters showing that there
  28.            is additional text on either side of the displayed text
  29.   inperr- returns a non-zero code if the input line is aborted with an
  30.           ESC character }
  31. procedure getinput(var s:string;hidden:boolean;hc:char;
  32.                    x1,y1,len,strlen,txt_at,scrl_at:byte;
  33.                    var inperr:integer);
  34. var
  35.   tmp,
  36.   fill : string;
  37.   curlen : byte absolute s;
  38.   strptr : byte;
  39.   done : boolean;
  40.   c : split;
  41.   i : byte;
  42. begin
  43.   fillchar(fill,sizeof(fill),32);
  44.   fill[0] := chr(len);
  45.   if x1+len+1 > 80 then exit;
  46.   if x1-1 < 1 then exit;
  47.   fillchar(s,sizeof(s),32);
  48.   curlen := 0;
  49.   strptr := 1;
  50.   done := false;
  51.   repeat
  52.     if getinput_debug then
  53.       begin
  54.         gotoxy(1,1);
  55.         write('STRPTR=',strptr:3,' CURLEN=',curlen:3,' LEN=',len:3,
  56.               ' STRLEN=',strlen:3);
  57.       end;  { if getinput_debug }
  58.     fasterwrite(fill,x1,y1,txt_at);
  59.     if strptr < len then
  60.       if curlen < len then
  61.         begin
  62.           tmp := copy(s,1,curlen);
  63.           gotoxy(x1+strptr-1,y1);
  64.         end  { if }
  65.       else
  66.         begin
  67.           tmp := copy(s,1,len-1);
  68.           gotoxy(x1+strptr-1,y1);
  69.         end  { else }
  70.     else
  71.       begin
  72.         tmp := copy(s,strptr-len+1,len-1);
  73.         gotoxy(x1+len-1,y1);
  74.       end;  { else }
  75.     if hidden then
  76.       fillchar(tmp[1],length(tmp),hc);
  77.     fasterwrite(tmp,x1,y1,txt_at);
  78.     getkey16(c);
  79.     case c.char of
  80.       #0:case c.scan of
  81.            #$4B:if strptr > 1 then dec(strptr);
  82.            #$4D:if strptr <= strlen then inc(strptr);
  83.            #$47:strptr := 1;  { HOME }
  84.            #$4F:
  85.              begin
  86.                i := strlen;
  87.                while s[i] = ' ' do
  88.                  dec(i);
  89.                strptr := i+1;
  90.              end;  { END }
  91.            #$53:
  92.              begin
  93.                delete(s,strptr,1);
  94.                tmp := s;
  95.                fillchar(s,sizeof(s),32);
  96.                s := tmp;
  97.              end;  { DEL }
  98.          end;  { case }
  99.       ' '..'~':if (curlen < strlen) and (strptr <= strlen) then
  100.         begin
  101.           insert(c.char,s,strptr);
  102.           inc(strptr);
  103.         end;  { }
  104.       #8:
  105.         if strptr > 1 then
  106.         begin
  107.           delete(s,strptr-1,1);
  108.           dec(strptr);
  109.         end;  { #8 }
  110.       #13:done := true;
  111.       #27:
  112.         begin
  113.           s := '';
  114.           done := true;
  115.         end;  { #27 }
  116.     end;  { case }
  117.  
  118.   until done;
  119. end;  { getinput }